package gri_macro_handler;

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
use Exporter;
use File::Basename;
use XML::Parser;
use XML::Simple;
use Data::Dumper;
use MIME::Base64;
use Cwd;
use Fcntl;
use Fcntl qw(:flock :seek);
use Sys::Hostname;
use IO::Handle;
use CGI;
use Socket;
use gri_secmgr qw(get_cookie_value got_cookie);

my $HOSTNAME=hostname;
my $obj=undef;

$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
	get_posted_vars
	to_bool
	lindex
	html_error
	link_to_str
	get_uploaded_file_handle
	get_authenticated_user
	allow_logout
	start_page
	start_html
	load_macro
	end_page
	end_html
	get_xml_file
	hex_to_string
	string_to_hex
	get_xml_attribute
	load_gri_macro_config
	pcodes_to_html
	get_project_xml
	get_client_sock
	shtml_page
	wc2_logmsg
	_encode_base64
	_decode_base64
);

sub _encode_base64($) {
	my $x=encode_base64($_[0]);
	$x =~ s/\n//g;
	return $x;
}

sub _decode_base64($) {
	return decode_base64($_[0]);
}

sub get_xml_attribute($$;$);
sub process_embedded_code($$;$$);

my $header_sent=0;
my $html_sent=0;
my %LOADED=();

{
my %loaded_files=();

sub get_xml_attribute($$;$) {
my ($file,$attr,$num)=@_;
my $ff;

	$num=0 if !defined($num);
	if(exists($loaded_files{$file})) {
		my $r=$loaded_files{$file};
		if(exists($r->{$attr})) {
			if(ref($r->{$attr}) eq "ARRAY") {
				return(undef) if !exists($r->{$attr}->[$num]);
				return $r->{$attr}->[$num];
			} else {
				return $r->{$attr};
			}
		}
		return undef;
	}
	open($ff,$file) or return(undef);
	my $d=join("",<$ff>);
	close($ff);
	my $xml=XMLin($d,forcearray=>1);
	$loaded_files{$file}=$xml;
	return get_xml_attribute($file,$attr,$num);
}

}

sub get_client_sock($$) {
my ($host,$port)=@_;

	my $iaddr = inet_aton($host) || return(undef,"Unable to resolve hostname: $!");
	my $paddr = sockaddr_in($port, $iaddr);
	my $proto = getprotobyname('tcp');
	my $fd;
	socket($fd,PF_INET,SOCK_STREAM,$proto) || return(undef,"Unable to create socket: $!");
	connect($fd, $paddr) || return (undef,"Unable to connect to server '$host': $!");
	my $x=select($fd);
	$|=1;
	select($x);
	return ($fd,undef);
	}

sub envs_to_cmd() {
my $str="";
my $v;
	if(exists($::CONFIG->{env})) {
		foreach $cvar (keys(%{$::CONFIG->{env}})) {
			$v=$::CONFIG->{env}->{$cvar};
			if(substr($v,0,1)eq "+") {
				$str.="$cvar=\"\$$cvar".substr($v,1)."\"; export $cvar; "
			} else {
				$str.="$cvar='$v'; export $cvar; ";
			}
		}
	}
	return $str;
}

sub _html($) {
my $a=$_[0];

	$a =~ s/ /&nbsp;/g;
	$a =~ s/"/&quot;/g;
	$a =~ s/</&lt;/g;
	$a =~ s/>/&gt;/g;
	$a =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/g;
	$a =~ s/\n/<br>/g;
	return($a);
}

sub start_page() {
	print "Content-Type: text/html\n\n" if !$header_sent;
	$header_sent=1;
	return "";
}


{
my $refresh;

sub start_html($$$) {
my $head=$_[0];
$refresh=$_[1];
my $css=$_[2];

	my $username=undef;
	if(!defined($css)) {
		my $v=get_cookie_value(name=>"gri_dbm_intranet");
		if(defined($v)) {
			$v=~ s/\s+.*//;
			$username=$v;
		}
		if(defined($username) && $username ne "public") {
			my $users_dir=$::GRI_FRONTEND->get_global_directory("users");
			if(-f "$users_dir/$username-prefs.xml") {
				my $xx=new gri_userprefs("$users_dir/$username-prefs.xml");
				if($xx) {
					my ($desc,$val)=$xx->get_pref_value("gri_stylesheet");
					if(defined($val)) {
						$css="/stylesheet-$val.css";
					}
				}
			}
		}
	}
	if(!defined($css)) {
		$css=$::ENV{CSS} if exists($::ENV{CSS});
		$css=$::ENV{GRI_STYLE_SHEET} if exists($::ENV{GRI_STYLE_SHEET});
		$css="/StyleGuide.css" if !defined($css);
	}

	#################################################################
	# If user agent is Gecko based then use a different css		#
	# file if available. This is because the Gecko rendering can	#
	# show the fonts in a smaller type-face.			#
	#################################################################

	if(! $html_sent) {
		print "<html>\n<head>\n";
		if(defined($head) && $head ne "") {
			print "<title>$head</title>\n";
		}
		if(defined($css)) {
			print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$css\"/>\n";
		}
		if($refresh) {
			print "<meta http-equiv=\"Refresh\" content=$refresh/>\n";
		} else {
			print "<meta http-equiv=\"pragma\" content=\"NO_CACHE\"/>\n";
		}
		print "</head>\n<body>\n";
	}
	$html_sent=1;
	return "";
}

sub end_page() {
	$header_sent=0;
	return "";
}

sub end_html() {
	$html_sent=0;
	print "</body>\n";
	if(! $refresh) {
		# microsoft recommendation?
		# print "<head><meta http-equiv=\"pragma\" content=\"NO_CACHE\"></head>\n";
		;
	}
	print "</html>\n";
	return "";
}

}

sub html_error($;$) {
my $msg=$_[0];
my $header=$_[1];

	if(!defined($header)) {
		$header=1;
	}

	if(!ref($msg)) {
		$msg={
			error => $msg,
			error2 => undef,
			title => "HTML Macro error",
			"link" => $link,
		};
	}
	if($header) {
		start_page;
		start_html($msg->{title},0,undef);
		load_macro('mm_header');
		print mm_header();
	}
	my $s="";
	$s="<div id=\"gri_error\"><br><div style=\"text-align: center;\">" . _html($msg->{error}) . "<br>&nbsp;</div></div>\n";
	if(exists($msg->{error2}) && defined($msg->{error2})) {
		$s.="<br><div id=\"gri_error2\">" . _html($msg->{error2}) . "</div>\n";
	}
	if(exists($msg->{"link"}) && defined($msg->{"link"})) {
		$s.="<center><br><br><br>$msg->{link}</center>\n";
	}
	if(!$header) {
		return $s;
	}
	print $s;
	end_html;
	end_page;
	exit(0);
}

sub handle_start {
my $expat=shift;
my $celement=shift;
my @c;

	%attrs=@_;
	$data="";

	@c=$expat->context;
	if($celement eq "gri_macro") {
		if(@c) {
			$expat->xpcroak("gri_macro element not top level element.");
		}
		return;
	}
	if($celement eq "authentication") {
		if($#c!=1 || $c[1] ne "site") {
			$expat->xpcroak("authentication element must be within site element.");
		}
		$obj->{site}->{authentication}->{$_}=$attrs{$_} foreach(keys(%attrs));
		return;
	}
	if($celement eq "mpl") {
		if($#c!=1 || $c[1] ne "site") {
			$expat->xpcroak("mpl element must be within site element.");
		}
		$obj->{site}->{mpl}->{$_}=$attrs{$_} foreach(keys(%attrs));
		return;
	}
	if($celement eq "cache") {
		if($#c!=1 || $c[1] ne "site") {
			$expat->xpcroak("cache element must be within site element.");
		}
		$obj->{cache}->{$_}=$attrs{$_} foreach(keys(%attrs));
		return;
	}
	if($celement eq "site") {
		if($#c!=0 || $c[0] ne "gri_macro") {
			$expat->xpcroak("site element must be with gri_macro top level element.");
		}
		return;
	}

	if($celement eq "env") {
		if($#c!=0 || $c[0] ne "gri_macro") {
			$expat->xpcroak("env element must be with gri_macro top level element.");
		}
		return;
	}
	if($celement eq "projects") {
		if($#c!=0 || $c[0] ne "gri_macro") {
			$expat->xpcroak("projects element must be with gri_macro top level element.");
		}
		return;
	}
	if($celement eq "var") {
		if($#c!=1 || $c[0] ne "gri_macro" || $c[1] ne "env") {
			$expat->xpcroak("var element must be with gri_macro/env element.");
			return;
		}
		if(!exists($attrs{name}) || !exists($attrs{value})) {
			$expat->xpcroak("var element must contain name/value attributes.");
			return;
		}
		$obj->{env}->{$attrs{name}}=$attrs{value};
		$::ENV{$attrs{name}}=$attrs{value};
		return;
	}
	if($celement eq "project") {
		if($#c!=1 || $c[0] ne "gri_macro" || $c[1] ne "projects") {
			$expat->xpcroak("var element must be with gri_macro/projects element.");
			return;
		}
		if(!exists($attrs{name}) || !exists($attrs{top}) || !exists($attrs{lname})) {
			$expat->xpcroak("project element must contain name/lname/top attributes.");
			return;
		}
		$obj->{projects}->{$attrs{name}}={};
		$obj->{projects}->{$attrs{name}}->{top}=$attrs{top};
		$obj->{projects}->{$attrs{name}}->{lname}=$attrs{lname};
		$obj->{projects}->{$attrs{name}}->{info}=$attrs{info} if exists($attrs{info});
		$obj->{projects}->{$attrs{name}}->{news}=$attrs{news} if exists($attrs{news});
		return;
	}
	if($celement eq "meta_repository") {
		if($#c!=0 || $c[0] ne "gri_macro") {
			$expat->xpcroak("meta_repository element must be within gri_macro element.");
			return;
		}
		if(!exists($attrs{top}) || !exists($attrs{locks}) || !exists($attrs{updates})) {
			$expat->xpcroak("meta_repository element must contain top/locks/updates attributes.");
		}
		$obj->{meta_repository}->{top}=$attrs{top};
		$obj->{meta_repository}->{locks}=$attrs{locks};
		$obj->{meta_repository}->{updates}=$attrs{updates};
		if(exists($attrs{frequency})) {
			$obj->{meta_repository}->{frequency}=$attrs{frequency};
		} else {
			$obj->{meta_repository}->{frequency}=300;
		}
		if(exists($attrs{logging})) {
			$obj->{meta_repository}->{logging}=$attrs{logging};
		} else {
			$obj->{meta_repository}->{logging}="off";
		}
		if(exists($attrs{logfile})) {
			$obj->{meta_repository}->{logfile}=$attrs{logfile};
		} else {
			$obj->{meta_repository}->{logfile}="/dev/null";
		}
		if(exists($attrs{updatefile})) {
			$obj->{meta_repository}->{updatefile}=$attrs{updatefile};
		}
		return;
	}
	$expat->xpcroak("Unknown element \"$celement\" encountered.");
}

sub handle_end {
my $expat=shift;
my $celement=shift;

	;
}

sub handle_char {
	$data.=$_[1];
}

#########################################################################
# Return index of first occurance of a pattern in an array.             #
#########################################################################

sub lindex(\@$) {
my ($lref,$val)=@_;
my $i=0;
my $n=scalar(@$lref);

	while($i<$n) {
		if($lref->[$i] =~ /$val/) {
			return $i;
		}
		++$i;
	}
	return -1;
}

#########################################################################
# Parse the gri_macro xml file and return a reference to the details.	#
#########################################################################

sub get_authenticated_user {
	if(exists($obj->{site}->{authentication}->{program}) &&
		-x $obj->{site}->{authentication}->{program}) {
		my $z=`$obj->{site}->{authentication}->{program} 2>/dev/null`;
		chomp $z;
		return $z;
	}
}

sub allow_logout {
my $default="yes";

	if(exists($obj->{site}->{authentication}->{logout}) &&
		$obj->{site}->{authentication}->{logout} eq "no") {
		return $obj->{site}->{authentication}->{logout};
	}
	return $default;
}

sub load_gri_macro_config($) {
my $cname=$_[0];
my ($P);

	local ($celement,$data,%attrs);

	$P=new XML::Parser(
		Handlers => {   Start   => \&handle_start,
				End     => \&handle_end,
				Char    => \&handle_char},
		ErrorContext => 2,
	);

	if(!defined($P)) {
		return(undef,"Unable to initiate XML parser.");
	}
	$obj={};
	eval {$P->parsefile($cname);};
	if($@) {
		return(undef,$@);
	}
	my $xx=$obj;
	return($xx,undef);
}

#########################################################################
### Below are methods that are refered to in the meta_repository xml. ###
#########################################################################

sub _load_gri_macro_if_needed() {
	return 1;
	if(!defined(&codemgr2::msg)) {
		push @INC,$::ENV{CODEMGR_LIBS};
		eval "use codemgr2 qw(get_version_contents msg get_project load_config load_releases load_release_files parse_rlog parse_rlogs);";
		if($@) {
			print "<?xml version=\"1.0\" standalone=\"yes\"?>\n";
			print "<error type=\"perl\">$@</error>\n";
			return 0;
		}
	}
	return 1;
}

sub get_uploaded_file_handle {
	if(!defined($::CGI_OBJ)) {
		$::CGI_OBJ=new CGI;
	}
	return $::CGI_OBJ->upload($_[0]);
}

sub get_posted_vars {
	if(!defined($::CGI_OBJ)) {
		$::CGI_OBJ=new CGI;
	}
	my @P=$::CGI_OBJ->param;
	foreach (@P) {
		my @y=$::CGI_OBJ->param($_);
		if(scalar(@y)==1) {
			$y[0] =~ s/\`//g;
			$y[0] =~ s/\|//g;
			# $y[0] =~ s/\&//g;
			$y[0] =~ s/\$//g;
			# $y[0] =~ s/\<//g;
			# $y[0] =~ s/\>//g;
			$::PARAM{$_}=$y[0];
			wc2_logmsg("$_ = $::PARAM{$_}\n");
		} else {
			my $xx=$_;
			my $i=0; 
			foreach (@y) {
				$y[$i] =~ s/\`//g;
				$y[$i] =~ s/\|//g;
				# $y[$i] =~ s/\&//g;
				$y[$i] =~ s/\$//g;
				# $y[$i] =~ s/\<//g;
				# $y[$i] =~ s/\>//g;
				$::PARAM{"$xx.$i"}=$y[$i];
				wc2_logmsg("$xx.$i = $y[$i]");
				print STDERR "$xx.$i = $y[$i]\n";
				$i++;
			}
		}
	}
}

sub add_generic_params {
my $lp;

	if(exists($::ENV{REQUEST_URI})) {
		$::PARAM{REQUEST_URI}=$::ENV{REQUEST_URI};
	}
}

#########################################################################
# This routine is called to convert text taken from XML files to HTML.	#
# The args are the arguments passed via the QUERY_STRING which are	#
# comma-separated and passed as a reference to a list (2nd arg).	#
#									#
# At present the following strings will be replaced in the XML...	#
# %{H1('header')}%	header 1					#
# %{H2('header')}%	header 2					#
#									#
# It will also possible to add links in the text using the following	#
# syntax:								#
#									#
# %{LINK('extra_path_info','args')}%					#
#									#
# This text is also passed through the shtml processign routine		#
# as well, allowing other code to be called...				#
#									#
# CACHING								#
# If a environment variable exists GRI_MACRO_CACHE and that directory	#
# exists and is writable then the CGI caching will take place. Here	#
# the contents of the %{...}% will generate a file name and if that	#
# file exists and is newer than one minute if will grab the contents	#
# of the file rather than running the code.				#
#									#
# If the file is older than 1 minute it is removed, the code run, and 	#
# the file contents generated again.					#
#									#
# Before any changes take place [such as updating the file], a		#
# lock must be granted.							#
#									#
#########################################################################

sub process_embedded_code($$;$$) {
my $cline=$_[0];
my $process_embedded_code_calls=$_[1];
local $allow_caching=$_[2];
my $early_only=$_[3];
$early_only=0 if !defined($early_only);

my $str="";
my $cache=undef;
my $cache_age=60;

	if(defined($obj)) {
		if(exists($obj->{cache}->{maxage})) {
			$cache_age=int($obj->{cache}->{maxage});
		}
	}

	$allow_caching=1 if !defined($allow_caching);
	if(exists($::ENV{GRI_MACRO_CACHE})) {
		$cache=$::ENV{GRI_MACRO_CACHE};
		if(! (-d $cache && -w _)) {
			$cache=undef;
		}
	}
	$cache=undef if $allow_caching==0;

	$::ENV{QUERY_STRING} =~ s/'//g;
	$::ENV{QUERY_STRING} =~ s/`//g;
	$::ENV{QUERY_STRING} =~ s/"//g;
	$::ENV{QUERY_STRING} =~ s/$//g;
	my @args=split(/,/,$::ENV{QUERY_STRING});
	for my $cc (@args) {
		if($cc =~ /=/) {
			my ($parm,$val)=($cc =~ /(.*?)=(.*)/);
			$val="" if !defined($val);
			$::PARAM{$parm}=$val;
		}
	}
	add_generic_params();
	$process_embedded_code_calls=0 if !defined($process_embedded_code_calls);
	# wc2_logmsg("process_embedded_code_calls: $process_embedded_code_calls\n");
	$process_embedded_code_calls++;
	if($process_embedded_code_calls>10) {
		wc2_logmsg("process_embedded_code: Recursion too deep!\n");
		exit 1;
		return "?RECURSION ERROR?";
	}
	#########################################################
	# Change any %ARGn% bits to actual values.		#
	#########################################################

	my ($i,$s,$s2);
	for($i=1;$i<10;$i++) {
		if($i-1>$#args) {
			$s="";
		} else {
			$s=$args[$i-1];
		}
		$cline =~ s/%ARG$i%/$s/g;
	}
	#################################################################
	# Posted variables are held in ::PARAM if the get_posted_vars	#
	# has been called. So handle elements %P:name% and replace with	#
	# value or ?name - not defined? if no such element.		#
	#################################################################

	while(1) {
		my ($var,$y);
		if($cline =~ /\%P:([a-zA-Z_0-9]+)%/) {
			$var=$1;
			if(exists($::PARAM{$var})) {
				$y=$::PARAM{$var};
				$y="" if !defined($y);
			} else {
				$y="?$var - not defined?";
			}
			$cline =~ s/\%P:$var%/$y/g;
		} else {
			last;
		}
	}
	if($early_only==0) {
		my $st=index($cline,"#{");
		if($st>-1) {
			my $st2=index($cline,"}#");
			if($st2>-1) {
				$cline=substr($cline,0,$st) . substr($cline,$st2+2);
			}
		}
	}

	while(length($cline)) {
		my ($st,$st2,$en,$cmd);

		# A section for simple early eval code first...	
		if($early_only) {
			$st=index($cline,"#{");
			if($st==-1) {
				return "$str";
			}
			$en=index($cline,"}#");
			$cmd=substr($cline,$st+2,$en-$st-2);
			load_code($cmd);

			my $xxx=eval "$cmd;";
			if($@) {
				print STDERR "Eval error for '$cmd': $@\n";
			} else {
				$xxx="" if !defined($xxx);
				$str.=$xxx;
			}
			$cline=substr($cline,$en+2);
			next;
		}

		$st=index($cline,"%{");
		if($st==-1) {
			$str.=$cline;
			last;
		}
		$en=index($cline,"}%");
		$st2=index($cline,"%{",$st+1);
		if($st2>=0 && $st2<$en) {

			#########################################
			# If st2 >=0 then the command has an 	#
			# embedded command, so some type of	#
			# recursion is necessary.		#
			#########################################
			$en=index($cline,"}%");
			if($en==-1) {
				$en=length($cline)-1;	# everything on the line
			}
			my $str2=substr($cline,$st2,$en-$st2+2); 
			$cline=substr($cline,0,$st2).process_embedded_code($str2,$process_embedded_code_calls,$caching,$early_only).substr($cline,$en+2);
			next;
		}
		if($en==-1) {
			$cmd=substr($cline,$st+2,30);
			$str.="!!Error running $cmd ... - no ending }%!!";
			wc2_logmsg("ERROR on \"$cmd ... \" - no ending }%\n");
			return $str;
		}
		$cmd=substr($cline,$st+2,$en-$st-2);
		$str.=substr($cline,0,$st);
		my $dd=undef;
		# Turn off all caching for now...
		if(1==2 && defined($cache)) {
			{
				my (@D,$dfd,$f,@s);
				@D=();
				if(opendir($dfd,$cache)) {
					while($f=readdir($dfd)) {
						if(-f "$cache/$f") {
							@s=stat(_);
							if(time-$s[9] > $cache_age) {
								push @D,"$cache/$f";
							}
						}
					}
					closedir($dfd);
					unlink @D;
				}
			}

			my $n=unpack("H*",$cmd);
			if(-f "$cache/$n") {
				my $fd;
				open($fd,"$cache/$n");
				if(defined($fd)) {
					$dd=join("",<$fd>);
					close($fd);
				}
			}
		}
		if(!defined($dd) || length($dd)==0) {
			load_code($cmd);

			my $xxx=eval "$cmd;";
			if($@) {
				$str.="!!Error running \"$cmd\": \n$@!!";
				wc2_logmsg("ERROR on \"$cmd\":\n$@\n");
				print STDERR "Eval error for '$cmd': $@\n";
			} else {
				$xxx="" if !defined($xxx);
				$str.=$xxx;
				if(defined($cache)) {
					my $n=unpack("H*",$cmd);
					my $fd=undef;
					if(open($fd,">$cache/$n.$$")) {
						print $fd $xxx;
						close($fd);
						unlink("$cache/$n");
						rename("$cache/$n.$$","$cache/$n");
					}
				}
			}
		} else {
			$str.=$dd;
		}
		$cline=substr($cline,$en+2);
	}
	# wc2_logmsg("str length=".length($str)."\n");
	return $str;
}

sub pcodes_to_html($) {
my ($string)=@_;
my $para="<br>";

	$string =~ s/__P/$para/g;

	$string=process_embedded_code($string,0);
	return $string;
}

sub load_code($) {
my ($f,$dir);

	$f=$_[0];
	$f =~ s/\n//g;
	$f =~ s/\(.*//; $f =~ s/;//g;
	if($f =~ /\n/) {
		$f =~ s/\n//g;
	}
	return if exists($LOADED{$f});
	$dir=$::ENV{GRI_MACRO_CODEDIR};
	$LOADED{$f}=1;
	if(-f "$dir/$f") {
		if(! -r _) {
			print STDERR "Unable to read $dir/$f!\n";
			return;
		}
		do "$dir/$f";
		if($@) {
			print STDERR "Failed to load $dir/$f:\n$@\n";
		}
	}
}

sub load_macro($) {
	load_code($_[0]);
}

sub shtml_page {
my ($dir,$fname,$code,$fd,$cline,$cmd);

	$do_page_end=1 if !defined($do_page_end);
	my $caching=1;
	if(exists($::ENV{PATH_INFO}) && $::ENV{PATH_INFO} =~ /!$/) {
		$caching=0;
		$::ENV{PATH_INFO} =~ s/!$//;
	}

	if(exists($::ENV{SCRIPT_NAME})) {
		$dir=dirname($::ENV{SCRIPT_FILENAME})."/templates";
	} else {
		$dir=cwd . "/templates";
	}

	if(!exists($::ENV{PATH_INFO})) {
		$fname="$dir/_.shtml";
	} else {
		$fname="$dir" . "/" . basename($::ENV{PATH_INFO}) . ".shtml";
	}
	$fname.=".$HOSTNAME" if -f "$fname.$HOSTNAME";
	if(! -f $fname) {
		my $fname2=$fname;
		$fname2=~ s/\.shtml$/.nph/;
		if(-f $fname2) {
			$fname=$fname2;
			$caching=0;
			#################################################
			# When processing nph stuff never cache, since	#
			# this type of page is also used for forms 	#
			# processing!					#
			#################################################
		}
	}

	if(! -f $fname) {
		start_page;
		$::ENV{PATH_INFO}="" if !exists($::ENV{PATH_INFO});
		$::ENV{QUERY_STRING}="" if !exists($::ENV{QUERY_STRING});
		$code="handle_page('" . $::ENV{PATH_INFO} . "','" . $::ENV{QUERY_STRING} . "');";
		eval "$code";
		if($@) {
			html_error("Error [2] running : $code\n$@");
		}
		return;
	}

	#################################################################
	# A template file appears to exist, so load it in and attempt	#
	# to perform any necessary replacements.			#
	#################################################################

	if(!open($fd,$fname)) {
		html_error("Unable to open page template file: $fname"); return;
	}

	#################################################################
	# Any code handling is now done by the process_embedded_code	#
	# routine rather than directly here.				#
	#################################################################

	$cline=join("",<$fd>); close($fd);
	if($fname =~ /\.shtml/) {
		$::RAW_OUTPUT_IT=0;
		my $xx2=process_embedded_code($cline,0,$caching,1);
		if($::RAW_OUTPUT_IT) {
			print $xx2;
			exit;
		}
		start_page;
		print $xx2;
		start_html(undef,0,undef);
		print process_embedded_code($cline,0,$caching,0),"\n";
		end_html;
		end_page;
	} else {
		my $xx2=process_embedded_code($cline,0,$caching,0);
		print substr($xx2,0,length($xx2)-1);
	}
	return;
}

sub handle_page($$) {
my ($path_info,$query_string)=@_;

	start_page;
	start_html("Missing place - place holder page shown!",0,undef);
	print "<P> Place holder page for $path_info :: $query_string</P>\n";
	end_html;
	end_page;
	return;
}

#########################################################################
# Get a file handle, otherwise undef if not available after 2 seconds.	#
#########################################################################

sub is_xml_empty($$$) {
my ($ref,$fname,$project)=@_;
my ($dir,@sb,$f);

	$dir=$ref->{meta_repository}->{updates};
	if(defined($project)) {
		$f="$dir/$fname.$project.xml";
	} else {
		$f="$dir/$fname.TOPLEVEL.xml";
	}
	return(1) if ! -f $f;
	@sb=stat(_);
	return(1) if $sb[7]==0;
	return 0;
}

sub get_xml_file {
my ($ref,$fname,$project,$not_blank)=@_;
my ($dir,$f,$fd);

	$not_blank=0 if !defined($not_blank);
	$dir=$ref->{meta_repository}->{updates};
	if(defined($project)) {
		$f="$dir/$fname.$project.xml";
	} else {
		$f="$dir/$fname.TOPLEVEL.xml";
	}

	$l=0;
	while($l<2) {
		if(open($fd,$f)) {
			if($not_blank) {
				my @s=stat($fd);
				return($fd) if $s[7];
				close($fd);
				return undef;
			} else {
				return($fd);
			}
		}
		$l++;
		select(undef,undef,undef,0.1);
	}
	return undef;
}

sub link_to($$$$) {
(my $ref,$text,$extra,$args)=@_;
my $hh;

	my $url_prefix=$::GRI_FRONTEND->get_url_prefix();
	$::ENV{SERVER_NAME}=$::ENV{WEBCODEMGR3_SERVER_NAME} if exists($::ENV{WEBCODEMGR3_SERVER_NAME});
	$::ENV{SERVER_NAME}="127.0.0.1" if !exists($::ENV{SERVER_NAME});
	$::ENV{SCRIPT_NAME}=basename($0) if !exists($::ENV{SCRIPT_NAME});
	$hh="$url_prefix$::ENV{SCRIPT_NAME}";
	if(defined($extra) && $extra ne "") {
		$hh.="/$extra";
	}
	if(defined($args) && $args ne "") {
		$hh.="?$args";
	}
	print "<a class=top href=\"$hh\">$text</a>";
	return "";
}

sub hex_to_string($) {
my $s=$_[0];

	$s="" if !defined($s);
	my $y=pack("H*",$s);
	$y =~ s/\`//g;
	$y =~ s/\|//g;
	# $y =~ s/\&//g;
	$y =~ s/\$//g;
	# $y =~ s/\<//g;
	# $y =~ s/\>//g;
	return $y;
}
sub string_to_hex($) {
my $s=$_[0];

	$s="" if !defined($s);
	return unpack("H*",$s);
}

# if the text argument is empty then just return the value can can
# be plugged into href...

sub link_to_str($$$$) {
my ($class,$text,$extra,$args)=@_;
my $hh;

	if(defined($class)) {
		$class="class=$class";
	} else {
		$class="class=stdlink";
	}
	my $url_prefix=$::GRI_FRONTEND->get_url_prefix();
	$::ENV{SERVER_NAME}=$::ENV{WEBCODEMGR3_SERVER_NAME} if exists($::ENV{WEBCODEMGR3_SERVER_NAME});
	$::ENV{SERVER_NAME}="127.0.0.1" if !exists($::ENV{SERVER_NAME});
	$::ENV{SCRIPT_NAME}=basename($0) if !exists($::ENV{SCRIPT_NAME});
	$hh="$url_prefix$::ENV{SCRIPT_NAME}";
	if(defined($extra) && $extra ne "") {
		$hh.="/$extra";
		if(defined($allow_caching) && $allow_caching==0) {
			$hh.="!";
		}
	}
	if(defined($args) && $args ne "") {
		$hh.="?$args";
	}
	# Get rid of double // since does weird things...
	{
		my ($p,$p2)=($hh =~ /^(.*?\/\/)(.*)/);
		$p2 =~ s!//!/!g;
		$hh=$p . $p2;
	}
	if(!defined($text) || !length($text)) {
		return $hh;
	}
	return "<a $class href=\"$hh\">$text</a>";
}

sub meta_repos_updates_required($) {
my $ref=$_[0];
my ($caction,$cproject);
my ($ref2,$fd,$ctime2,$xx2);

	return(0) if !exists($ref->{meta_repository}->{actions}); # nothing to do
	_load_gri_macro_if_needed();
	return(0) if !exists($ref->{meta_repository}->{updatefile});
	sysopen($fd,$ref->{meta_repository}->{updatefile},O_RDWR|O_CREAT,0775);
	if(!flock($fd,LOCK_EX|LOCK_NB)) {
		close($fd);
		return(0);
	}
	seek($fd,0,SEEK_SET);
	sysread($fd,$ctime2,12);
	close($fd);
	$ctime2 =~ s/\s+//g;
	$ctime2=int($ctime2);
	if($ctime2+30>time) { return(0); }
	return(1);
}

#########################################################################
# The process now splits into two - one handling any updates (if	#
# necessary), whilst the other renders the current page.		#
# The child must close fd's since web server will wait until the	#
# descriptors close before exiting the request.				#
#########################################################################

my ($LOGGING,$LOGFD);

sub wc2_logmsg(@) {
	if(!defined($LOGGING)) {
		if(!exists($::CONFIG->{meta_repository}->{logging})) {
			$LOGGING=0;
			return;
		}
		$LOGGING=$::CONFIG->{meta_repository}->{logging};
		if(lc($LOGGING) ne "on") {
			$LOGGING=0;
		} else {
			$LOGGING=1;
		}
		my $xl=$::CONFIG->{meta_repository}->{logfile};
		open($LOGFD,">>$xl");
		if(defined($LOGFD)) {
			my $xx=select $LOGFD;
			$|=1;
			select $xx;
		} else {
			$LOGGING=0;
		}
	}
	return if !$LOGGING;
	print $LOGFD @_;
	print STDERR @_;

	# LOGFD is left open on purpose...
}

sub to_bool($) {
my $x=shift;

	if($x =~ /^\d+$/) {
		return int($x);
	}
	if($x =~ /^(true|y|yes|ok)$/i) {
		return 1;
	}
	return 0;
}

1;

